home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / BARGR2.for < prev    next >
Text File  |  1991-04-13  |  5KB  |  178 lines
  1.         SUBROUTINE BARGR2(XLOW,XHIGH,NOBARS,IMXPTS,IMYPTS,X,
  2.      1                 SXLAB,SYLAB,STITLE,TYPE,COLIST)
  3.         IMPLICIT NONE
  4. C
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C       PROJECT NAME: GRAPHICS UTILITY
  8. C       FILE NAME   : BARGR2.FOR
  9. C       ROUTINE NAME: BARGR2
  10. C       ROUTINE TYPE: SUBROUTINE
  11. C       LANGUAGE    : COMPATIBLE FORTRAN
  12. C
  13. C       VERSION     : 1
  14. C
  15. C       ORIGINAL AUTHOR: JOE P GARBARINI JR, (BARGRA.FOR)
  16. C       DATE           : 02-JUL-82
  17. C       EDITED INTO BARGR2: JIM LOCKER
  18. C       DATE           : 19 DEC 1988
  19. C
  20. C       MAINTAINER     : HAL R BRAND L126 X26313 (DIGLIB V2 VERSION)
  21. C
  22. C       REVISION: 0
  23. C         REVISION AUTHOR:
  24. C         REVISION DATE  :
  25. C         REVISION NOTES :
  26. C
  27. C       SUMMARY:
  28. C
  29. C               This routine makes a bar graph (frequency graph)
  30. C               from an array of real data.
  31. C
  32. C       INPUT VARIABLES:
  33. C
  34. C               XLOW  : REAL*4 CONSTANT OR VARIABLE.
  35. C                       THE LOW LIMIT FOR THE X-AXIS.
  36. C                       MUST HAVE XLOW <= X(I) FOR ALL I.
  37. C               XHIGH : REAL*4 CONSTANT OR VARIABLE.
  38. C                       THE HIGH LIMIT FOR THE X-AXIS.
  39. C                       MUST HAVE X(I) <= XHIGH FOR ALL I.
  40. C               NOBARS: INTEGER CONSTANT OR VARIABLE.
  41. C                       THE NUMBER OF BARS TO DRAW.
  42. C                       1 <= *NOBARS* <= 512
  43. C                       SEE LOCAL VARIABLE *IMXC*.
  44. C               IMXPTS: INTEGER CONSTANT OR VARIABLE.
  45. C                       THE X DIMENSION OF ARRAY *X*.
  46. C               IMYPTS: INTEGER CONSTANT OR VARIABLE.
  47. C                       THE Y DIMENSION OF ARRAY *X*, ALSO
  48. C                       THE NUMBER OF INDEPENDENT BAR GRAPHS
  49. C                       TO BE PLACED ON EACH PLOT. (MAX 8)
  50. C               X     : REAL*4 VARIABLE.
  51. C                       THE ARRAY OF REAL DATA TO GRAPH.
  52. C               SXLAB : LOGICAL*1 CONSTANT OR VARIABLE.
  53. C                       THE X-AXIS LABLE.
  54. C               SYLAB : LOGICAL*1 CONSTANT OR VARIABLE.
  55. C                       THE Y-AXIS LABLE.
  56. C               STITLE: LOGICAL*1 CONSTANT OR VARIABLE.
  57. C                       THE TITLE.
  58. C               TYPE  : INTEGER CONSTANT OR VARIABLE.
  59. C                       THE AXIS FLAG.  SEE *DIGLIB* DOCUMENTATION.
  60. C               COLIST: INTEGER CONSTANT OR ARRAY
  61. C                       THE PEN COLORS TO BE EMPLOYED.  ONE PEN COLOR
  62. C                       ENTRY FOR EACH INDEPENDENT BAR GRAPH TO BE MADE.
  63. C
  64. C       OUTPUT VARIABLES: NONE
  65. C
  66. C       INOUT VARIABLES: NONE
  67. C
  68. C       COMMON VARIABLES: NONE
  69. C
  70. C       LOCAL VARIABLES: SEE CODE.
  71. C
  72. C       EXCEPTION HANDLING: NONE
  73. C
  74. C       SIDE EFFECTS: NONE
  75. C
  76. C       PROGRAMMING NOTES:
  77. C
  78. C               This routine does all the calls to DIGLIB necessary
  79. C               to do the plot EXCEPT for a call to DEVSEL.  This
  80. C               way the calling program can choose the device.
  81. C
  82. C               DIGLIB's MAPIT routine uses its own rules for the
  83. C               actual lowest and highest values on the axes.  They
  84. C               always include the users values.  If you wish to move
  85. C               the bar graph away from the left and/or (imaginary) right
  86. C               y axis do the following:
  87. C
  88. C               Let S = (XH - XL) / NOBARS where XH = max X(i)
  89. C               and XL = min X(i).  Now set XLOW = XL - N * S
  90. C               XHIGH = XH + M * S where N,M are chosen at your discretion.
  91. C
  92. C               MAKE SURE THAT XLOW <= X(I) <= XHIGH FOR ALL I.
  93. C
  94. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  95. C
  96.         INTEGER IMXPTS,IMYPTS,NOBARS,TYPE,COLIST(8)
  97.         REAL*4    XLOW,XHIGH
  98.         REAL*4  X(IMXPTS,IMYPTS),FIMX(8)
  99.         LOGICAL SXLAB(20),SYLAB(20),STITLE(20)
  100. C
  101.         INTEGER I,J,IMXC,KK,IERR
  102.         REAL*4    COUNT(512,8),STEP,FBAR,YLOW,YHIGH,X0,Y0,VX0,VX1
  103.         REAL*4    VY0,VY1
  104. C
  105.         IMXC   = 512
  106.         YLOW   = 0.0
  107.         YHIGH  = 1.0
  108.         FBAR   = FLOAT(NOBARS)
  109. C
  110.         IF (XLOW .GE. XHIGH) GOTO 9999
  111.         IF (NOBARS .GT. IMXC) GOTO 9999
  112.         IF(IMYPTS .GT. 8) GOTO 9999
  113. C
  114.         STEP   = (XHIGH - XLOW) / FBAR
  115. C
  116.         DO 100 I = 1,NOBARS
  117.         DO 100 J = 1,IMYPTS
  118. C
  119.             COUNT(I,J) = 0.0
  120. C
  121.  100    CONTINUE
  122. C
  123.         DO 350 KK=1,IMYPTS
  124.         DO 200 I = 1,IMXPTS
  125. C
  126.             J      = INT((X(I,KK)-XLOW)/STEP) + 1
  127.             IF (J .GT. NOBARS) J = NOBARS
  128.             COUNT(J,KK) = COUNT(J,KK) + 1.0
  129. C
  130.  200    CONTINUE
  131. C
  132.         FIMX(KK)   = FLOAT(IMXPTS) * STEP
  133. C
  134.         DO 300 I = 1,NOBARS
  135. C
  136.             COUNT(I,KK) = COUNT(I,KK) / FIMX(KK)
  137. C
  138.  300    CONTINUE
  139.  350    CONTINUE
  140. C
  141.         CALL MINMAX(COUNT,NOBARS*IMYPTS,YLOW,YHIGH)
  142.         YLOW   = 0.0
  143.         YHIGH  = YHIGH + 0.1 * YHIGH
  144. C
  145.         CALL BGNPLT
  146.         CALL MAPSIZ(0.0,100.0,0.0,90.0,0.0)
  147.         CALL MAPIT(XLOW,XHIGH,YLOW,YHIGH,SXLAB,SYLAB,STITLE,TYPE)
  148. C
  149.         DO 500 KK=1,IMYPTS
  150.         CALL GSCOLR(COLIST(KK),IERR)
  151.         X0     = XLOW
  152.         Y0     = 0.0
  153.         CALL SCALE(X0,Y0,VX0,VY0)
  154.         CALL GSMOVE(VX0,VY0)
  155. C
  156.         DO 400 I = 1,NOBARS
  157. C
  158.             X0     = XLOW + I * STEP
  159.             Y0     = COUNT(I,KK)
  160.             CALL SCALE(X0,Y0,VX1,VY1)
  161.             CALL GSDRAW(VX0,VY1)
  162.             CALL GSDRAW(VX1,VY1)
  163.             CALL GSDRAW(VX1,VY0)
  164. C
  165.             VX0    = VX1
  166. C
  167.  400    CONTINUE
  168.  500    CONTINUE
  169. C
  170.         CALL ENDPLT
  171. C
  172.  9999   CONTINUE
  173. C
  174. C       BYE
  175. C
  176.         RETURN
  177.         END
  178.